perm filename SCAN.BKP[XX,LCS] blob
sn#209698 filedate 1976-04-03 generic text, type T, neo UTF8
00010 TITLE SCANR
00020 ENTRY SCANR
00030 ML←5 ↔ K←0 ↔ NNUM←14 ↔ ISKP←13 ↔ JJ←12 ↔ XMINUS←11 ↔ DECI←10
00040 M←7 ↔ N←6 ↔ QQ←4
00050 DEFINE LL <SCN> ↔ DEFINE LR<SCN+1> ↔ DEFINE LBL <SCN+4>
00060 DEFINE LSL <SCN+5> ↔ DEFINE LST <SCN+6> ↔ DEFINE LCM <SCN+7>
00070 DEFINE LE <SCN+=8> ↔ DEFINE LC <SCN+=9> ↔ DEFINE LS <SCN+=10>
00080 DEFINE LPL <SCN+=11> ↔ DEFINE LMI <SCN+=12> ↔ DEFINE LF <SCN+=13>
00090 DEFINE LA <SCN+=14> ↔ DEFINE LI <SCN+=15> ↔ DEFINE LW <SCN+=16>
00095 DEFINE JN <SC+=10> ↔ DEFINE DBST <SC+=11> ↔ DEFINE ISEMI <SC+=14>
00097 DEFINE IXX <SC+=13> ↔ DEFINE MODE <SC+=70> ↔ DEFINE VX <SC+=16>
00100 ; 00100 C SUBRS. SCANR, NALF, EDIT, PRESCN
00500 ; 00300 C ***** MSS SCANNER *************************
00800 ; 00400 SUBROUTINE SCANR
01100 ; 00500 DIMENSION IQ(10),LRUD(4)
01300 ; 00600 COMMON/ALF/INP(72),ML
01400 ;650 COMMON/SCN/LL,LR,LU,LD,LBL,LSL,LST,LCM,LE,LC,LS,LPL,LMI,LF,LA,LI,LW
01600 ; 00700 COMMON /SC/J,L,MK
01700 ; 00800 1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,IXX,ISEMI,QQ
01800 ; 00900 1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
02000 ;1000 EQUIVALENCE (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
02200 ; 01100 DATA LRUD/'L','R','U','D'/
02400 ; 01200 C FOR LEFT, RIGHT, UP, DOWN, EDIT
02410 MOVE ML,ALF+=72 ; 5 IS ML UNTIL RETURN
02600 ; 01300 NNUM=-1
02700 SETOM NNUM
02900 ; 01400 ISKP=0
03000 SETZM ISKP
03200 ; 01500 JJ=0
03300 SETZM JJ
03500 ; 01600 XMINUS=1.
03600 MOVSI XMINUS,201400
03900 ; 01700 C LEAVES BLANK WHEN REST.
04100 ; 01800 999 DECI=-1
04200 S999: MOVSI DECI,576400
04500 ; 01900 M=0
04600 SETZM M
04800 ; 02000 2799 N=INP(ML)
05000 S2799: MOVE N,INP -1(ML)
05300 ; 02100 899 ML=ML+1
05400 S899: AOS ML
05600 S781P: CAMN N,LSL ; 02200 781 IF(N.EQ.'/')N=ISEMI
05700 MOVE N,ISEMI
06400 ; 02300 C FOR MOTIVIC TRANFORMATIONS
06600 ; 02380 IF(N.EQ.'*')GO TO 751
06800 CAME N,LST
06810 CAMN N,ISEMI
06900 JRST S751
07100 ; 02400 IF(N.EQ.ISEMI)GO TO 751
07600 ; 02500 C '*' AND '/' ADDED ABOVE 4/18/73
07800 ; 02600 IF(N.NE.IXX)GO TO 22
08000 CAMN N,IXX
08050 SKIPGE SC+=10 ; JN
08100 JRST S22
08300 ; 02650 IF(JN)GO TO 22
08700 ; 02700 IF(ISKP.EQ.0)GO TO 210
08900 JUMPE ISKP,S210
09100 ; 02800 ML=ML-1
09200 SOS ML
09400 ; 02900 GO TO 202
09500 JRST S202
09700 ; 03000 22 IF(N.EQ.IBLA)GO TO 4702
09900 S22: CAMN N,LBL
10000 JRST S4702
10100 ; 03050 IF(N.NE.',')GO TO 510
10300 CAME N,LCM
10400 JRST S510
10600 ; 03100 4702 IF(ISKP)202,2799,2799
10900 ; 03200 512 ML=ML+1
11000 S4702: JUMPGE ISKP,S2799
11100 JRST S202
11150 S512: MOVE 2,ISEMI
11200 AOS ML
11400 ; 03300 IF(INP(ML).EQ.ISEMI)RETURN
11700 CAMN 02,INP -1(ML)
11800 JRST SEND
11900 JRST S512+1
12200 ; 03400 GO TO 512
12700 ; 03600 510 IF(JN.GE.0)GO TO 173
12800 S510: MOVE 02,JN
12900 JUMPGE 02,S173
13100 ; 03700 C SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
13300 ; 03800 JN=1
13400 MOVEI 02,1
13500 MOVEM 02,JN
13700 ; 03900 DO 702 K=1,4
13800 MOVEI K,1
14200 ; 04000 702 IF(N.EQ.LRUD(K))GO TO 703
14400 S702: CAMN N,SCN -1(15)
14500 JRST S703
14600 CAIGE K,4
14700 AOJA K,S702
14900 ; 04100 C FINDS L, R, U, D
15000 ; 04200 C YOU CAN TYPE THE FULL WORD
15200 ; 04300 703 JJ=JJ+1
15300 S703: AOS JJ
15500 ; 04400 IF(K.NE.4)GO TO 77
15700 CAIE K,4
15800 JRST S77
16000 ; 04450 IF(INP(ML).EQ.'E')K=99
16100 MOVE 2,LE
16200 CAMN 2,INP-1(ML)
16300 MOVEI K,=99 ; 04500 C 'DE'=DELETE
17100 ; 04600 77 IF(N.EQ.'E')K=55
17200 S77: CAMN N,LE
17300 MOVEI K,=55 ; 04700 C 'E'= EDIT
18100 ; 04800 IF(N.EQ.'C')K=2222
18200 CAMN N,LC
18300 MOVEI K,=2222 ; COPY
18900 ; 04900 IF(N.EQ.IXX)K=222
19000 CAMN N,IXX ; EXIT
19100 MOVEI K,=222
19700 ; 05000 C 'C'=COPY, 'X'=EXIT FROM EDIT MODE
19800 ; 05100 VX(JJ)=K
19900 TLC K,232000
20000 FADR K,K
20100 MOVEM K,VX-1(JJ)
20400 ; 05200 704 IF(INP(ML).EQ.IBLA)GO TO 2799
20500 S704: MOVE 2,INP-1(ML)
20600 CAME 2,LBL
20700 CAMN 2,LCM
20800 JRST S2799
21000 ; 05250 IF(INP(ML).EQ.',')GO TO 2799
21600 ; 05300 C PUT COMMA ERASER IN SCX.
21800 ; 05400 ML=ML+1
21900 AOS ML
22100 ; 05500 C SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
22300 ; 05600 GO TO 704
22400 JRST S704
22600 ; 05700 173 K=NALF(N)
22700 S173: JSA 16,NALF
22800 JUMP N ; 0 IS K
23100 ; 05800 IF(N.GT.0)GO TO 1410
23200 JUMPG N,S1410
23400
23500 ; 05810 IF(K.EQ.18)GO TO 73
23600 MOVEI 02,22
23700 CAMN 02,K
23800 JRST 73P
23900
24000 ; 05815 C JUMP IF A REST OR OTHER R'S
24100
24200 ; 05820 IF(MODE.EQ.2)GO TO 144
24300 MOVEI 02,2
24400 CAMN 02,MODE
24500 JRST S144
24700 ; 05860 C YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
24800 ; 05900 C JUMP IF NOT A LETTER
25000 ; 06000 QQ=0
25100 SETZM QQ ; QQ IS 4
25300 CAIGE =8 ; 06100 IF(K.LT.8)GO TO 15
25600 JRST S15
25800 ; 06200 C JUMP IF A POSSIBLE NOTE
26000 ; 06300 IF(K.NE.11)GO TO 16
26100 CAIE =11
26300 JRST S16
26500 ; 06400 C JUMP IF NOT A KSIG
26700 ; 06500 18 N=INP(ML)
26800 S18: MOVE N,INP-1(ML)
27200 ; 06600 ML=ML+1
27300 AOS ML
27500 ; 06700 IF(N.EQ.IBLA)GO TO 18
27600 CAME N,LBL
27700 CAMN N,LS
27800 JRST S18
28000 ; 06750 IF(N.EQ.'S')GO TO 18
28500 ; 06775 IF(N.EQ.'+')GO TO 18
28700 CAMN N,LPL
28800 JRST S18
29000 ; 06800 IF(N.EQ.ISEMI)GO TO 20
29100 CAMN N,ISEMI
29300 JRST S20
29500 ; 06900 IF(N.EQ.'-')GO TO 177
29700 CAMN N,LMI
29800 JRST S177
30000 ; 06950 IF(N.NE.'F')GO TO 19
30200 CAME N,LF
30300 JRST S19
30500 ; 07000 177 QQ=-10000.
30600 S177: MOVN QQ,[10000.0]
30900 ; 07100 GO TO 18
31000 JRST S18
31200 ; 07200 19 A=NALF(N)
31300 S19: JSA 16,NALF
31400 JUMP N
31500 TLC K,232000
31600 FADR K,K ; K IS NOW A
32000 ; 07300 GO TO 18
32100 S19: JRST S18 ; ???? WHAT WAS THIS FOR IN ORIGINAL???
32300 ; 07400 20 VX(1)=-A*1000.-99.+QQ
32400 S20: FSBR QQ,[99.0]
32600 FMPRI K,212764
32800 FSBR QQ,K
32900 MOVNM QQ,VX
33100 ; 07500 C -4099=4 SHARPS, -14099=4 FLATS, ETC.
33300 ; 07600 RETURN
33400 JRST SEND
33600 ; 07700 16 IF(K.NE.9)GO TO 2
33700 S16: CAIE =9
33900 JRST S2
34100 ; 07800 VX(1)=22.
34200 MOVSI 02,205540
34300 MOVEM 02,VX
34500 ; 07900 C FOR EDIT I21 ETC.
34600 ; 08000 GO TO 2799
34700 JRST S2799
34900 ; 08100 2 IF(K.NE.13)GO TO 3
35000 S2: CAIE =13
35200 JRST S3
35400 ; 08200 C JUMP IF NOT A MEASURE LINE
35600 ; 08300 VX(1)=-599.
35700 MOVN 02,[599.0]
35800 MOVEM 02,VX
36000 ; 08310 JN=INP(ML)
36200 MOVE JN,INP -1(ML)
36500 ; 08320 IF(JN.NE.LD)GO TO 23
36700 CAME JN,LD
36800 JRST S23
37000 ; 08330 ML=ML+1
37100 AOS ML
37300 ; 08340 C FOUND 'MDN' -- FOR DOUBLE BARS
37500 ; 08350 JN=0
37600 SETZM JN
37800 ; 08360 VX(1)=-609.
37900 MOVN 02,[609.0]
38000 MOVEM 02,VX
38200 ; 08400 23 K=NALF(INP(ML))
38300 S23: JSA 16,NALF
38400 JUMP INP-1(ML)
39000 ; 08500 IF(K.LE.0)GO TO 512
39200 JUMPLE K,S512
39400 ; 08505 IF(K.GT.9)GO TO 512
39500 CAILE =9
39700 JRST S512
39900 ; 08510 IF(JN.EQ.0)K=K+10
40000 SKIPN JN
40100 ADDI =10
40800 ; 08575 VX(1)=-599.-K
40900 TLC K,232000
41000 FADR K,K
41100 FADR K,[599.0]
41200 MOVNM K,VX
41400 ; 08600 C 'M2'= A BAR LINE UP 2 STAVES. ETC.
41600 ; 08700 GO TO 512
41700 JRST S512
41900 ; 08800 3 IF(K.GT.16)GO TO 4
42000 S3: CAILE =16
42200 JRST S4
42400 ; 08900 C JUMP IF NOT FOR 'PROXIMITY' MODE
42600 ; 09000 NSWCH=K-15
42700 SUBI =15
42900 MOVEM K,NSWCH
43000 ************************************
43100 ; 09100 GO TO 2799
43200 JRST S2799
43300
43400 ; 09200 C TO SWITCH ALWAYS USE OCT.# /PBF4/ /OE5/ P=PROXIMITY, O=ORDINARY
43500
43600 ; 09500 4 IF(K.NE.20)GO TO 21
43700 4P MOVEI 02,24
43800 CAME 02,K
43900 JRST 21P
44000
44100 ; 09600 C TRY AGAIN IF NOT A 'T'
44200
44300 ; 09700 IF(INP(ML).GT.0)GO TO 2799
44400 MOVE 03,ML
44500 MOVE 02,INP -1(ML)
44600 JUMPG 02,S2799
44700
44800 ; 09800 C T12,8/ ETC. MAKES A METER, OR TIME SIG. POS NUMS ARE NOT LETTERS!
44900
45000 ; 09900 VX(1)=-199.
45100 MOVN 02,CONST.+15
45200 MOVEM 02,VX
45300
45400 ; 10000 IF(INP(ML).EQ.'E')VX(1)=-499.
45500 MOVE 02,CONST.+3
45600 MOVE 03,ML
45700 CAME 02,INP -1(ML)
45800 JRST 13M
45900 MOVN 02,CONST.+16
46000 MOVEM 02,VX
46100 13M BLOCK 0
46200
46300 ; 10100 GO TO 51
46400 JRST 51P
46500
46600 ; 10200 21 IF(K.NE.19)GO TO 899
46700 21P MOVEI 02,23
46800 CAME 02,K
46900 JRST S899
47000
47100 ; 10300 C JUMP IF NOT 'S' STEM
47200
47300 ; 10400 VX(1)=-699.
47400 MOVN 02,CONST.+17
47500 MOVEM 02,VX
47600
47700 ; 10500 C UP=-699
47800
47900 ; 10600 IF(INP(ML).EQ.LDN)VX(1)=-799.
48000 MOVE 02,LDN
48100 MOVE 03,ML
48200 CAME 02,INP -1(ML)
48300 JRST 14M
48400 MOVN 02,CONST.+20
48500 MOVEM 02,VX
48600 14M BLOCK 0
48700
48800 ; 10700 GO TO 512
48900 JRST S512
49000
49100 ; 10800 C NEXT IT'S A NOTE OR CLEF
49200
49300 ; 10900 15 NNUM=K-2
49400 S15: MOVNI 02,2
49500 ADD 02,K
49600 MOVEM 02,NNUM
49700
49800 ; 11000 IF(NNUM.LE.0)NNUM=NNUM+7
49900 MOVE 02,NNUM
50000 JUMPG 02,15M
50100 MOVEI 02,7
50200 ADDM 02,NNUM
50300 15M BLOCK 0
50400
50500 ; 11100 N=INP(ML)
50600 MOVE 03,ML
50700 MOVE 02,INP -1(ML)
50800 MOVEM 02,N
50900
51000 ; 11200 IF(N.NE.'A')GO TO 5
51100 MOVE 02,CONST.+21
51200 CAME 02,N
51300 JRST 5P
51400
51500 ; 11300 C JUMP IF NOT BASS CLEF
51600
51700 ; 11400 VX(1)=-299.
51800 MOVN 02,CONST.+22
51900 MOVEM 02,VX
52000
52100 ; 11500 51 IF(XMINUS)VX(1)=VX(1)-.5
52200 51P MOVE 02,XMINUS
52300 JUMPGE 02,16M
52400 MOVN 02,CONST.+23
52500 FADRM 02,VX
52600 16M BLOCK 0
52700
52800 ; 11600 C TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
52900
53000 ; 11700 GO TO 512
53100 JRST S512
53200
53300 ; 11800 5 IF(N.NE.'L')GO TO 6
53400 5P MOVE 02,CONST.+24
53500 CAME 02,N
53600 JRST 6P
53700
53800 ; 11900 C JUMP IF NOT ALTO CLEF
53900
54000 ; 12000 VX(1)=-399.
54100 MOVN 02,CONST.+25
54200 MOVEM 02,VX
54300
54400 ; 12100 GO TO 51
54500 JRST 51P
54600 ; 12200 6 K=1
54700 6P MOVEI 02,1
54800 MOVEM 02,K
54900
55000 ; 12300 IF(NNUM.GT.3)K=2
55100 MOVEI 02,3
55200 CAML 02,NNUM
55300 JRST 17M
55400 MOVEI 02,2
55500 MOVEM 02,K
55600 17M BLOCK 0
55700
56000 ; 12500 C FOUND A NOTE
56100
56200 ; 12600
56300
56400 ; 12700 IF(N.EQ.IXX)GO TO 5410
56500 MOVE 02,N
56600 CAMN 02,IXX
56700 JRST 5410P
56800
56900 ; 12800 C FOR GX3/ ETC.
57000
57100 ; 12900 K=NALF(N)
57200 JSA 16,NALF
57300 ARG 00,N
57400 MOVEM 00,K
57500
57600 ; 13000 IF(N.GT.0)GO TO 7
57700 MOVE 02,N
57800 JUMPG 02,7P
57900
58000 ; 13100 C JUMP IF NOT A LETTER
58100
58200 ; 13200 QQ=100000.
58300 MOVE 02,CONST.+26
58400 MOVEM 02,QQ
58500
58600 ; 13300 IF(K.EQ.14)GO TO 610
58700 MOVEI 02,16
58800 CAMN 02,K
58900 JRST 610P
59000
59100 ; 13400 IF(K.EQ.19)GO TO 8
59200 MOVEI 02,23
59300 CAMN 02,K
59400 JRST 8P
59500 ; 13500 C JUMP IF NATURAL
59600
59700 ; 13600 QQ=1000.
59800 MOVSI 02,212764
59900 MOVEM 02,QQ
60000
60300 ; 13800 GO TO 610
60400 JRST 610P
60500
60600 ; 13900 8 QQ=10000.
60700 8P MOVE 02,CONST.+11
60800 MOVEM 02,QQ
60900
61200 ; 14100 610 ML=ML+1
61300 610P AOS ML
61400
61500 ; 14200 K=NALF(INP(ML))
61600 MOVE 03,ML
61700 MOVEI 02,INP -1(ML)
61800 HRRM 02,18M
61900 JSA 16,NALF
62000 18M ARG 00,18M
62100 MOVEM 00,K
62200
62300 ; 14300 7 IF(K.EQ.11)GO TO 5410
62400 7P MOVEI 02,13
62500 CAMN 02,K
62600 JRST 5410P
62700
62800 ; 14350 IF(K.LT.0)GO TO 5410
62900 MOVE 02,K
63000 JUMPL 02,5410P
63100
63200 ; 14400 C JUMP IF SEMICOLON OR BLANK
63300
63400 ; 14500 IF(K.NE.24)GO TO 24
63500 MOVEI 02,30
63600 CAME 02,K
63700 JRST 24P
63800
64100 ; 14700 GO TO 5410
64200 JRST 5410P
64300 ; 14800 24 JSCA=K-1
64400 24P MOVNI 02,1
64500 ADD 02,K
64600 MOVEM 02,JSCA
64700
64800 ; 14900 ML=ML+1
64900 AOS ML
65000
65300 ; 15100 GO TO 2410
65400 JRST 2410P
65500
65800 ; 15300 5410 IF(NSWCH.EQ.0)GO TO 2410
65900 5410P MOVE 02,NSWCH
66000 JUMPE 02,2410P
66100
66200 ; 15400 C K=-16 IS A BLANK??
66300
66400 ; 15500 IF(K.EQ.-3)GO TO 277
66500 MOVNI 02,3
66600 CAMN 02,K
66700 JRST S277
66800
66900 ; 15550 IF(K.NE.-5)GO TO 7410
67000 MOVNI 02,5
67100 CAME 02,K
67200 JRST 7410P
67300
67400 ; 15600 277 NOLD=NOLD-6*(K+4)
67500 S277: MOVEI 02,4
67600 ADD 02,K
67700 IMULI 02,6
67800 SUBM 02,NOLD
67900 MOVNS 00,NOLD
68000
68100 ; 15700 ML=ML+1
68200 AOS ML
68300
68400 ; 15800 C -=-3 +=-5 /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
68500
68800 ; 15910 7410 JJ=NOLD-NNUM
68900 7410P MOVN 02,NNUM
69000 ADD 02,NOLD
69100 MOVEM 02,JJ
69200
69300 ; 15920 IF(JJ.LT.4)GO TO 377
69400 MOVEI 02,4
69500 CAMLE 02,JJ
69600 JRST S377
69700
69800 ; 15950 IF(JSCA.LT.7)JSCA=JSCA+1
69900 MOVEI 02,7
70000 CAMG 02,JSCA
70100 JRST 19M
70200 AOS JSCA
70300 19M BLOCK 0
70400
70700 ; 16010 377 IF(JJ.GT.-4)GO TO 2410
70800 S377: MOVNI 02,4
70900 CAMGE 02,JJ
71000 JRST 2410P
71100
71200 ; 16050 IF(JSCA.GT.0)JSCA=JSCA-1
71300 MOVE 02,JSCA
71400 JUMPLE 02,20M
71500 SOS JSCA
71600 20M BLOCK 0
71700
71800 ; 16100 C WILL JUMP TO NEAREST NOTE (CHROM)**** MAY 22,71 (DIATONIC-'75)
71900
72000 ; 16200 2410 JJ=1
72100 2410P MOVEI 02,1
72200 MOVEM 02,JJ
72300
72400 ; 16300 VX2=0
72500 SETZM VX2
72600
72900 ; 16410 VX1=(JSCA*7+NNUM+QQ)*DBST
73000 JSA 16,FLOAT
73100 ARG 00,NNUM
73200 FADR 00,QQ
73300 MOVEI 02,7
73400 IMUL 02,JSCA
73500 MOVEM 00,%TEMP.
73600 JSA 16,FLOAT
73700 ARG 00,2
73800 FADR 00,%TEMP.
73900 FMPR 00,DBST
74000 MOVEM 00,VX1
74200 ; 16500 C DOUBLE STOPS ARE NEG. NUMBERS
74400 ; 16600 NOLD=NNUM
74500 MOVE 02,NNUM
74600 MOVEM 02,NOLD
74800 ; 16700 4410 NNUM=-2
74900 4410P MOVNI 02,2
75000 MOVEM 02,NNUM
75200 ; 16800 IF(INP(ML).EQ.ISEMI)RETURN
75300 MOVE 02,ISEMI
75400 MOVE 03,ML
75500 CAME 02,INP -1(ML)
75600 JRST 21M
75700 JRST 4M
75800 21M BLOCK 0
76000 ;16900 ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
76200 ; 17000 GO TO 310
76300 JRST 310P
76500 ; 17100 210 JJ=JJ+1
76600 S210: AOS JJ
76700
76800 ; 17200 IF(JJ.EQ.1)GO TO 3310
76900 MOVEI 02,1
77000 CAMN 02,JJ
77100 JRST 3310P
77200
77300 ; 17300 XMINUS=1.
77400 MOVSI 02,201400
77500 MOVEM 02,XMINUS
77600
77700 ; 17400 VX(JJ)=0
77800 MOVE 02,JJ
77900 SETZM VX -1(2)
78000
78100 ; 17500 C 'X N1,N2' MAY REPLACE 'REP N1,N2'. N2=0 BECOMES N2=2
78200
78300 ; 17600 GO TO 310
78400 JRST 310P
78500
78600 ; 17700
78700
78800 ; 17800 C JUMP IF A LETTER
78900
79000 ; 17900 1410 IF(N.NE.'-')GO TO 14
79100 S1410: MOVE 02,CONST.+7
79200 CAME 02,N
79300 JRST 14P
79400
79500 ; 18000 XMINUS=-1.
79600 MOVN 02,CONST.+27
79700 MOVEM 02,XMINUS
79800
79900 ; 18100 GO TO 2799
80000 JRST S2799
80100
80200 ; 18102 144 TRIP=0
80300 S144: SETZM TRIP
80400
80500 ; 18105 444 IF(K.EQ.8)VX1=2
80600 444P MOVEI 02,10
80700 CAME 02,K
80800 JRST 22M
80900 MOVSI 02,202400
81000 MOVEM 02,VX1
81100 22M BLOCK 0
81200
81300 ; 18107 IF(K.EQ.4)VX1=.5
81400 MOVEI 02,4
81500 CAME 02,K
81600 JRST 23M
81700 MOVSI 02,200400
81800 MOVEM 02,VX1
81900 23M BLOCK 0
82000
82100 ; 18110 IF(K.EQ.5)VX1=8
82200 MOVEI 02,5
82300 CAME 02,K
82400 JRST 24M
82500 MOVSI 02,204400
82600 MOVEM 02,VX1
82700 24M BLOCK 0
82800
82900 ; 18115 IF(K.EQ.7)VX1=88
83000 MOVEI 02,7
83100 CAME 02,K
83200 JRST 25M
83300 MOVSI 02,207540
83400 MOVEM 02,VX1
83500 25M BLOCK 0
83600
83700 ; 18120 IF(K.EQ.19)VX1=16
83800 MOVEI 02,23
83900 CAME 02,K
84000 JRST 26M
84100 MOVSI 02,205400
84200 MOVEM 02,VX1
84300 26M BLOCK 0
84400
84500 ; 18125 IF(K.NE.20)GO TO 244
84600 MOVEI 02,24
84700 CAME 02,K
84800 JRST 244P
84900
85000 ; 18126 VX1=12
85100 MOVSI 02,204600
85200 MOVEM 02,VX1
85300
85400 ; 18127 N=INP(ML)
85500 MOVE 03,ML
85600 MOVE 02,INP -1(ML)
85700 MOVEM 02,N
85800
85900 ; 18129 IF(N.EQ.LBL)GO TO 344
86000 MOVE 02,N
86100 CAMN 02,LBL
86200 JRST 344P
86300
86400 ; 18131 IF(N.EQ.ISEMI)GO TO 344
86500 MOVE 02,N
86600 CAMN 02,ISEMI
86700 JRST 344P
86800
86900 ; 18133 TRIP=-1
87000 MOVSI 02,576400
87100 MOVEM 02,TRIP
87200
87300 ; 18150 ML=ML+1
87400 AOS ML
87500
87600 ; 18155 K=NALF(N)
87700 JSA 16,NALF
87800 ARG 00,N
87900 MOVEM 00,K
88000
88100 ; 18160 GO TO 444
88200 JRST 444P
88300
88400 ; 18220 244 IF(K.EQ.23)VX1=1
88500 244P MOVEI 02,27
88600 CAME 02,K
88700 JRST 27M
88800 MOVSI 02,201400
88900 MOVEM 02,VX1
89000 27M BLOCK 0
89100
89200 ; 18222 IF(K.EQ.17)VX1=4
89300 MOVEI 02,21
89400 CAME 02,K
89500 JRST 28M
89600 MOVSI 02,203400
89700 MOVEM 02,VX1
89800 28M BLOCK 0
89900
90000 ; 18223 C TS=24TH, TQ=6, TH=3.
90100
90200 ; 18224 C FOR S,E,Q,H,W,D,T RHYTH. 'T'(K=20) =TRIPLET D=DBL WHL NOTE
90300
90400 ; 18225 IF(TRIP)VX1=VX1*1.5
90500 MOVE 02,TRIP
90600 JUMPGE 02,29M
90700 MOVSI 02,201600
90800 FMPRM 02,VX1
90900 29M BLOCK 0
91000
91100 ; 18226 344 JJ=JJ+1
91200 344P AOS JJ
91300
91400 ; 18228 GO TO 1310
91500 JRST 1310P
91600
91700 ; 18230 14 ISKP=-1
91800 14P SETOM ISKP
91900
92000 ; 18300 IF(N.NE.'.')GO TO 79
92100 MOVE 02,CONST.+30
92200 CAME 02,N
92300 JRST 79P
92400
92500 ; 18400 DECI=M
92600 JSA 16,FLOAT
92700 ARG 00,M
92800 MOVEM 00,DECI
92900
93000 ; 18500 GO TO 75
93100 JRST 75P
93200
93300 ; 18600 79 M=M+1
93400 79P AOS M
93500
93600 ; 18700 IQ(M)=NALF(N)
93700 JSA 16,NALF
93800 ARG 00,N
93900 MOVE 02,M
94000 MOVEM 00,IQ -1(2)
94100
94200 ; 18800
94300 ; 18900 75 IF(N.EQ.ISEMI)GO TO 751
94400 75P MOVE 02,N
94500 CAMN 02,ISEMI
94600 JRST S751
94700
94800 ; 18950 IF(INP(ML).NE.1)GO TO 2799
94900 MOVEI 02,1
95000 MOVE 03,ML
95100 CAME 02,INP -1(ML)
95200 JRST S2799
95300
95400 ; 19000 751 IF(ISKP.EQ.0)RETURN
95500 S751: MOVE 02,ISKP
95600 JUMPN 02,30M
95700 JRST 4M
95800 30M BLOCK 0
95900
96000 ; 19100 202 IF(DECI.NE.-1)GO TO 302
96100 S202: MOVSI 02,576400
96200 CAME 02,DECI
96300 JRST 302P
96400
96500 ; 19200 DECI=0
96600 SETZM DECI
96700
96800 ; 19300 GO TO 402
96900 JRST 402P
97000
97100 ; 19400 302 DECI=M-DECI
97200 302P JSA 16,FLOAT
97300 ARG 00,M
97400 FSBRM 00,DECI
97500
97600 ; 19500 402 RRN=0
97700 402P SETZM RRN
97800
97900 ; 19600 REXP=M-1
98000 MOVNI 02,1
98100 ADD 02,M
98200 JSA 16,FLOAT
98300 ARG 00,2
98400 MOVEM 00,REXP
98500
98600 ; 19700 IF(M.LT.1)M=1
98700 MOVEI 02,1
98800 CAMG 02,M
98900 JRST 31M
99000 MOVEI 02,1
99100 MOVEM 02,M
99200 31M BLOCK 0
99300
99400 ; 19800 DO 171 K=1,M
99500 MOVEI 15,1
99600 32M MOVEM 15,K
99700 33M BLOCK 0
99800
00100 ; 19900 IF(REXP.GT.1)GO TO 1
00200 MOVSI 02,201400
00300 CAMGE 02,REXP
00400 JRST 1P
00500
00600 ; 20000 RRV=10
00700 MOVSI 02,204500
00800 MOVEM 02,RRV
00900
01000 ; 20100 IF(REXP.EQ.0)RRV=1
01100 MOVE 02,REXP
01200 JUMPN 02,34M
01300 MOVSI 02,201400
01400 MOVEM 02,RRV
01500 34M BLOCK 0
01600
01700 ; 20200 GO TO 11
01800 JRST 11P
01900
02000 ; 20300 1 RRV=10.**REXP
02100 1P MOVSI 02,204500
02200 MOVE 03,REXP
02300 PUSHJ 17,EXP3.2
02400 MOVEM 02,RRV
02500
02600 ; 20400 11 RRN=RRN+IQ(K)*RRV
02700 11P MOVE 02,K
02800 JSA 16,FLOAT
02900 ARG 00,IQ -1(2)
03000 FMPR 00,RRV
03100 FADRM 00,RRN
03200
03300 ; 20500 171 REXP=REXP-1
03400 171P MOVSI 02,576400
03500 FADRM 02,REXP
03600 MOVE 15,K
03700 CAMGE 15,M
03800 AOJA 15,32M
03900
04000 ; 20600 A=10.**DECI
04100 MOVSI 02,204500
04200 MOVE 03,DECI
04300 PUSHJ 17,EXP3.2
04400 MOVEM 02,A
04500
04600 ; 20700 IF(DECI.EQ.0)A=1.
04700 MOVE 02,DECI
04800 JUMPN 02,35M
04900 MOVSI 02,201400
05000 MOVEM 02,A
05100 35M BLOCK 0
05200
05300 ; 20800 JJ=JJ+1
05400 AOS JJ
05500
05600 ; 20900 VX(JJ)=RRN/A*XMINUS
05700 MOVE 02,RRN
05800 FDVR 02,A
05900 FMPR 02,XMINUS
06000 MOVE 03,JJ
06100 MOVEM 02,VX -1(ML)
06200
06300 ; 21000 JN=-JN
06400 MOVNS 00,JN
06500
06600 ; 21100 C SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
06700
06800 ; 21200 IF(MODE.NE.2)XMINUS=1.
06900 MOVEI 02,2
07000 CAMN 02,MODE
07100 JRST 36M
07200 MOVSI 02,201400
07300 MOVEM 02,XMINUS
07400 36M BLOCK 0
07500
07600 ; 21300 C************: MODE #?
07700
07800 ; 21400 C ONLY ONE - NEEDED FOR RHY.COMPOSITE
07900
08000 ; 21500 1310 IF(INP(ML).NE.1)GO TO 310
08100 1310P MOVEI 02,1
08200 MOVE 03,ML
08300 CAME 02,INP -1(ML)
08400 JRST 310P
08500
08600 ; 21600 VX(JJ+1)=VX(JJ)*2.
08700 MOVE 03,JJ
08800 MOVE 02,VX -1(ML)
08900 FSC 02,1
09000 MOVEM 02,VX (ML)
09100
09200 ; 21700 JJ=JJ+1
09300 AOS JJ
09400 ; 21800 ML=ML+1
09500 AOS ML
09600
09700 ; 21900 GO TO 1310
09800 JRST 1310P
09900
10000 ; 22000 206 ML=ML+2
10100 206P MOVEI 02,2
10200 ADDM 02,ML
10300
10400 ; 22100 3310 VX(1)=-99.
10500 3310P MOVN 02,CONST.+12
10600 MOVEM 02,VX
10700
10800 ; 22200 310 ISKP=0
10900 310P SETZM ISKP
11000
11100 ; 22300 IF(N.NE.ISEMI)GO TO 999
11200 MOVE 02,N
11300 CAME 02,ISEMI
11400 JRST S999
11500
11600 ; 22400
11700
11800 ; 22500 RETURN
11900 JRST 4M
12000
12100 ; 22600 73 JJ=JJ+1
12200 73P AOS JJ
12300
12400 ; 22650 K=INP(ML)
12500 MOVE 03,ML
12600 MOVE 02,INP -1(ML)
12700 MOVEM 02,K
12800
12900 ; 22700 IF(K.EQ.'E')GO TO 206
13000 MOVE 02,CONST.+3
13100 CAMN 02,K
13200 JRST 206P
13300
13400 ; 22800 C NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST
13500
13600 ; 22810 IF(K.EQ.'D')GO TO 1073
13700 MOVE 02,CONST.+31
13800 CAMN 02,K
13900 JRST 1073P
14000
14100 ; 22820 C /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
14200 ; 22830 IF(K.EQ.'U')GO TO 1173
14300 MOVE 02,CONST.+32
14400 CAMN 02,K
14500 JRST S1173
14600
14700 ; 22900 IF(K.EQ.'I')GO TO 573
14800 MOVE 02,CONST.+33
14900 CAMN 02,K
15000 JRST 573P
15100
15200 ; 22910 IF(K.EQ.'W')GO TO 273
15300 MOVE 02,CONST.+34
15400 CAMN 02,K
15500 JRST 273P
15600
15700 ; 22920 C /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
15800
15900 ; 22930 C *** ADD NUMBERS LATER *****
16000
16100 ; 22932 K=NALF(K)
16200 JSA 16,NALF
16300 ARG 00,K
16400 MOVEM 00,K
16500
16600 ; 22934 IF(K)GO TO 673
16700 MOVE 02,K
16800 JUMPL 02,673P
16900
17000 ; 22936 IF(K.GE.10)GO TO 673
17100 MOVEI 02,12
17200 CAMG 02,K
17300 JRST 673P
17400
17500 ; 22940 973 KV=NALF(INP(ML+1))
17600 973P MOVE 03,ML
17700 MOVEI 02,INP (ML)
17800 HRRM 02,37M
17900 JSA 16,NALF
18000 37M ARG 00,37M
18100 MOVEM 00,KV
18200
18300 ; 22941 C FOR 3-DIG. NUMBS. CAN TAKE NUM UP TO 999 FOR RESTS.
18400
18500 ; 22942 IF(KV)GO TO 873
18600 MOVE 02,KV
18700 JUMPL 02,873P
18800
18900 ; 22944 IF(KV.GE.10)GO TO 873
19000 MOVEI 02,12
19100 CAMG 02,KV
19200 JRST 873P
19300
19400 ; 22945 ML=ML+1
19500 AOS ML
19600
19700 ; 22946 K=K*10+KV
19800 MOVEI 02,12
19900 IMUL 02,K
20000 MOVE 03,KV
20100 ADD 03,2
20200 MOVEM 03,K
20300
20400 ; 22948 GO TO 973
20500 JRST 973P
20600
20700 ; 22950 873 QQ=K+87
20800 873P MOVEI 02,127
20900 ADD 02,K
21000 JSA 16,FLOAT
21100 ARG 00,2
21200 MOVEM 00,QQ
21300
21400 ; 22951 GO TO 473
21500 JRST 473P
21600
21700 ; 22952 673 QQ=85
21800 673P MOVSI 02,207524
21900 MOVEM 02,QQ
22000
22100 ; 22956 GO TO 373
22200 JRST 373P
22300
22400 ; 22960 573 QQ=86
22500 573P MOVSI 02,207530
22600 MOVEM 02,QQ
22700
22800 ; 22970 GO TO 473
22900 JRST 473P
23000
23100 ; 22980 273 QQ=87
23200 273P MOVSI 02,207534
23300 MOVEM 02,QQ
23400
23500 ; 22990 473 ML=ML+1
23600 473P AOS ML
23700
23800 ; 23000 373 VX(JJ)=QQ
23900 373P MOVE 02,JJ
24000 MOVE 03,QQ
24100 MOVEM 03,VX -1(2)
24200 ; 23300 GO TO 4410
24300 JRST 4410P
24400
24500 ; 23310 1073 QQ=20001
24600 1073P MOVE 02,CONST.+35
24700 MOVEM 02,QQ
24800
24900 ; 23320 GO TO 473
25000 JRST 473P
25100
25200 ; 23330 1173 QQ=20000
25300 S1173: MOVE 02,CONST.+36
25400 MOVEM 02,QQ
25500
25600 ; 23340 GO TO 473
25700 JRST 473P
25800
25900 ; 23400 END
26000
26100 JRST 4M
26200 SCANR% ARG 00,0
26300 MOVEM 15,TEMP.
26400 MOVEM 16,TEMP. +1
26500 JRST 1M
26600 4M MOVE 15,TEMP.
26700 MOVE 16,TEMP. +1
26800 JRA 16,0(16)
26900